home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / newsgrp / group01b.txt / 000052_icon-group-sender_Wed Mar 7 13:38:30 2001.msg < prev    next >
Internet Message Format  |  2002-01-03  |  3KB
  1. Return-Path: <icon-group-sender>
  2. Received: (from root@localhost)
  3.     by baskerville.CS.Arizona.EDU (8.11.1/8.11.1) id f27KcRU24299
  4.     for icon-group-addresses; Wed, 7 Mar 2001 13:38:27 -0700 (MST)
  5. Message-Id: <200103072038.f27KcRU24299@baskerville.CS.Arizona.EDU>
  6. From: "Geoff Summerhayes" <sNuOmSrPnAoMt@hNoOtSmPaAiMl.com>
  7. X-Newsgroups: comp.lang.apl,comp.lang.forth,comp.lang.icon,comp.lang.lisp,comp.lang.mumps,comp.lang.scheme,comp.lang.smalltalk
  8. Subject: Re: New Scientist Puzzle
  9. Date: Wed, 7 Mar 2001 15:32:00 -0500
  10. X-Priority: 3
  11. X-MSMail-Priority: Normal
  12. X-Newsreader: Microsoft Outlook Express 5.50.4522.1200
  13. X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4522.1200
  14. X-Complaints-To: newsabuse@supernews.com
  15. To: icon-group@cs.arizona.edu
  16. Errors-To: icon-group-errors@cs.arizona.edu
  17. Status: RO
  18. Content-Length: 1907
  19.  
  20.  
  21. "WildHeart'2k1" <stf+inetnews@apl.it> wrote in message
  22. news:985niv$4qa4$1@stargate1.inet.it...
  23. >
  24. >
  25. > The prolog solution is interesting because it almost literally (in English)
  26. > implement the statement of the problem.
  27. >
  28.  
  29. Unfortunately, the Prolog solution has a flaw in it that isn't exposed because
  30. the problem only has one solution. write/1 doesn't allow backtracking, the
  31. program as it stood only produced the first solution it came across.
  32. My revised solution follows, I've altered the digit-picking logic to do the
  33. comparisons automatically instead of having to hand-code them, takes longer
  34. but is scalable. create_number/3 is also more general than before.
  35. I've also altered some of the variable names to make the logic a little clearer.
  36.  
  37. leading_digit(X,L,[X|L]) :-
  38.    member(X,[1,2,3,4,5,6,7,8,9]),
  39.    \+ member(X,L).
  40.  
  41. digit(X,L,[X|L]) :-
  42.    member(X,[0,1,2,3,4,5,6,7,8,9]),
  43.    \+ member(X,L).
  44.  
  45. pure_square(A) :-
  46.    B is round(sqrt(A)), A is B * B.
  47.  
  48. create_number([],N,N).
  49. create_number([H|T],N,NR):-
  50.     N1 is N*10+H,
  51.     create_number(T,N1,NR).
  52.  
  53. passes_criteria(V,I,E,R,N,U,VIER,NEUN) :-
  54.    create_number([V,I,E,R],0,VIER),
  55.    create_number([N,E,U,N],0,NEUN),
  56.    pure_square(VIER),pure_square(NEUN).
  57.  
  58. possible_solutions(VIER,NEUN) :-
  59.    leading_digit(V,[],L), leading_digit(N,L,L1),
  60.    digit(I,L1,L2), digit(E,L2,L3),
  61.    digit(R,L3,L4), digit(U,L4,_),
  62.    passes_criteria(V,I,E,R,N,U,VIER,NEUN).
  63.  
  64. count_matches(_,[],0).
  65. count_matches([X,Y],[[X,_]|T],V):-!,count_matches([X,Y],T,V1),V is V1 + 1.
  66. count_matches([X,Y],[[_,Y]|T],V):-!,count_matches([X,Y],T,V1),V is V1 + 1.
  67. count_matches(A,[_|T],V):-count_matches(A,T,V).
  68.  
  69. solve(V,N):-
  70.    bagof([X,Y],possible_solutions(X,Y),Possibles),
  71.    member([V,N],Possibles),
  72.    count_matches([V,N],Possibles,Count),
  73.    1 is Count.
  74.  
  75. % d:/prolog/lisp.prolog compiled 0.00 sec, 5,780 bytes
  76.  
  77. ?- solve(VIER,NEUN).
  78.  
  79. VIER = 6241
  80. NEUN = 9409 ;
  81.  
  82. No
  83. ?-
  84.  
  85.  
  86. ---Geoff---
  87.  
  88.  
  89.